home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH6 / SRC / EASY3D.FRM < prev    next >
Text File  |  1995-10-29  |  3KB  |  132 lines
  1. VERSION 4.00
  2. Begin VB.Form Easy3DForm 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Easy 3D"
  6.    ClientHeight    =   4290
  7.    ClientLeft      =   1860
  8.    ClientTop       =   1650
  9.    ClientWidth     =   4560
  10.    BeginProperty Font 
  11.       name            =   "Times New Roman"
  12.       charset         =   1
  13.       weight          =   700
  14.       size            =   24
  15.       underline       =   0   'False
  16.       italic          =   -1  'True
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    Height          =   4980
  20.    Left            =   1800
  21.    LinkTopic       =   "Form1"
  22.    ScaleHeight     =   286
  23.    ScaleMode       =   3  'Pixel
  24.    ScaleWidth      =   304
  25.    Top             =   1020
  26.    Width           =   4680
  27.    Begin VB.PictureBox Picture1 
  28.       AutoRedraw      =   -1  'True
  29.       BackColor       =   &H00FFFF00&
  30.       BorderStyle     =   0  'None
  31.       Height          =   1335
  32.       Left            =   0
  33.       ScaleHeight     =   89
  34.       ScaleMode       =   3  'Pixel
  35.       ScaleWidth      =   305
  36.       TabIndex        =   0
  37.       Top             =   3000
  38.       Width           =   4575
  39.    End
  40.    Begin VB.Menu mnuFile 
  41.       Caption         =   "&File"
  42.       Begin VB.Menu mnuFileExit 
  43.          Caption         =   "E&xit"
  44.       End
  45.    End
  46. End
  47. Attribute VB_Name = "Easy3DForm"
  48. Attribute VB_Creatable = False
  49. Attribute VB_Exposed = False
  50. Option Explicit
  51.  
  52. Sub SeparateColor(color As Long, r As Integer, g As Integer, b As Integer)
  53.     r = color Mod 256
  54.     g = color \ 256 Mod 256
  55.     b = color \ 256 \ 256
  56. End Sub
  57.  
  58.  
  59.  
  60. Private Sub Form_Load()
  61. Const txt = "3D text the easy way!"
  62. Const GAP = 1
  63.  
  64. Dim x As Single
  65. Dim y As Single
  66. Dim r As Integer
  67. Dim g As Integer
  68. Dim b As Integer
  69. Dim oldcolor As Long
  70.     
  71.     CurrentX = 10
  72.     CurrentY = 10
  73.     Text3d Me, txt, vbBlack, RGB(127, 127, 127), vbWhite
  74.  
  75.     CurrentX = 10
  76.     Text3d Me, txt, BackColor, vbBlack, vbWhite
  77.  
  78.     SeparateColor BackColor, r, g, b
  79.     CurrentX = 10
  80.     Text3d Me, txt, BackColor, RGB(r / 2, g / 2, b / 2), vbWhite
  81.  
  82.     CurrentX = 10
  83.     Text3d Me, txt, vbBlue, vbBlack, vbWhite
  84.  
  85.     CurrentX = 10
  86.     Text3d Me, txt, Picture1.BackColor, vbBlack, vbWhite
  87.  
  88.     Picture1.CurrentX = 10
  89.     Picture1.CurrentY = 10
  90.     Text3d Picture1, txt, Picture1.BackColor, vbBlack, vbWhite
  91.     
  92.     SeparateColor BackColor, r, g, b
  93.     Picture1.CurrentX = 10
  94.     Text3d Picture1, txt, Picture1.BackColor, RGB(r / 2, g / 2, b / 2), vbWhite
  95. End Sub
  96.  
  97. Sub Text3d(pic As Object, txt As String, fore As Long, shadow As Long, highlight As Long)
  98. Const ADJUST = 1
  99.  
  100. Dim x As Single
  101. Dim y As Single
  102. Dim oldcolor As Long
  103.  
  104.     oldcolor = pic.ForeColor
  105.     x = pic.CurrentX
  106.     y = pic.CurrentY
  107.     
  108.     pic.ForeColor = highlight
  109.     pic.CurrentX = x - ADJUST
  110.     pic.CurrentY = y - ADJUST
  111.     pic.Print txt
  112.  
  113.     pic.ForeColor = shadow
  114.     pic.CurrentX = x + ADJUST
  115.     pic.CurrentY = y + ADJUST
  116.     pic.Print txt
  117.  
  118.     pic.ForeColor = fore
  119.     pic.CurrentX = x
  120.     pic.CurrentY = y
  121.     pic.Print txt
  122.  
  123.     pic.ForeColor = oldcolor
  124. End Sub
  125.  
  126.  
  127. Private Sub mnuFileExit_Click()
  128.     Unload Me
  129. End Sub
  130.  
  131.  
  132.